home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Info-Mac 4
/
Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso
/
Development
/
Source
/
DBL Pascal Library
/
INIT Shell Folder
/
INIT Shell ƒ
/
ShowIcon.p
< prev
Wrap
Text File
|
1990-03-26
|
2KB
|
97 lines
unit ShowIcon;
interface
uses
SysEqu;
procedure ShowIcon (id: INTEGER);
implementation
function RegA5: LONGINT;
inline
$2E8D; {MOVE.L A5,(SP)}
procedure SetA5 (where: Ptr);
inline
$2A5F; {MOVEA.L (SP)+,A5}
function CheckH (n: INTEGER): INTEGER;
inline
$301F, {MOVE.W (SP)+,D0}
$E358, {ROL.W #1,D0}
$0A40, $1021, {EORI.W #$1021,D0}
$3E80; {MOVE.W D0,(SP)}
procedure ShowIcon (id: INTEGER);
const
HOffsetAddr = CurApName + 28;
CheckAddr = CurApName + 30;
hOffset = 40;
vOffset = 40;
iconResType = 'ICN#';
type
ICN = record
data: array[1..32] of LONGINT;
mask: array[1..32] of LONGINT;
end;
ICNPtr = ^ICN;
ICNHandle = ^ICNPtr;
IntPtr = ^INTEGER;
LongPtr = ^LONGINT;
OSTypePtr = ^OSType;
QDGlobals = record
private: packed array[1..202] of Byte;
thePort: GrafPtr;
end;
var
theIcon: ICNHandle;
srcRect, dstRect: Rect;
saveA5: LONGINT;
myBitMap: BitMap;
myPort: GrafPort;
localQD: QDGlobals;
localA5: LONGINT;
begin
theIcon := ICNHandle(GetResource(iconResType, id));
if theIcon <> nil then
begin
HLock(Handle(theIcon));
saveA5 := RegA5;
SetA5(@localA5);
LongPtr(CurrentA5)^ := LONGINT(@localA5);
InitGraf(@localQD.thePort);
OpenPort(@myPort);
if CheckH(IntPtr(HOffsetAddr)^) <> IntPtr(CheckAddr)^ then
IntPtr(HOffsetAddr)^ := 8;
with myPort, dstRect do
begin
top := portRect.bottom - vOffset;
left := IntPtr(HOffsetAddr)^;
bottom := top + 32;
right := left + 32;
end;
with myBitMap do
begin
baseAddr := @theIcon^^.mask;
rowBytes := 4;
SetRect(bounds, 0, 0, 32, 32);
end;
SetRect(srcRect, 0, 0, 32, 32);
CopyBits(myBitMap, myPort.portBits, srcRect, dstRect, srcBic, nil);
myBitMap.baseAddr := @theIcon^^.data;
CopyBits(myBitMap, myPort.portBits, srcRect, dstRect, srcOr, nil);
IntPtr(HOffsetAddr)^ := IntPtr(HOffsetAddr)^ + hOffset;
IntPtr(CheckAddr)^ := CheckH(IntPtr(HOffsetAddr)^);
ClosePort(@myPort);
ReleaseResource(Handle(theIcon));
SetA5(Pointer(saveA5));
LongPtr(CurrentA5)^ := saveA5;
end;
end;
end.